proc fmgr: rem File Manager - Version 3.0 global ifmask$(55),fmask$(55),s$(100,55),s%,fpath$(40),i%,eswit%,ec%,lc% global pswit%,pg%,off%(6),pdev$(40),mess$(80) global totSize&,fndSwit%, upFlag%, dnFlag%, uline% global uopt$(1),sb%,sback% global fRestrt% :rem inverted routine restart rem Variables from finfo: global fname$(128),a$(128),flname$(128) global fzts$(130) :rem ZTS version of fname$ global e% :rem error from FilStatusGet global ver%,attrib%,size&,mdate&,spare& :rem keep together global yr%,mo%,dy%,hr%,mn%,sc%,yrday% global fMod$(1), fSys$(1), fHid$(1), fRO$(1) global fDate$(10), fTime$(7), fSize$(5) rem Screen Stack global stname$(16,128) global slim%,sx% global fx%(20),fy%(20),fnum% rem Frame details global colw%(9),colT%(9) global ncols%,maxH%,maxW%,lines% global fontH%,fontW%,frq% rem Frame store global sName$(20,80) global sPath$(20,80) global sHid$(20,1) global sMod$(20,1) global sSys$(20,1) global sRO$(20,1) global sAct$(20,1) global sDate$(20,10) global sTime$(20,7) global sSize$(20,5) allInit: intro: while 1 loopInit: uDialog: if uopt$="P" dirPrint: elseif uopt$="D" dinit: while uopt$<>"Q" nextDir: uOption: endwh exitDlog: else stop endif endwh endp proc intro: endp proc uDialog: rem Get User parameters and indicate P=Print, rem D=Display or Q=Quit in uopt$ cls dinit "File Manager V3.0" dedit ifmask$,"File mask" dchoice pswit%,"Ouput to","Display,Printer" dedit pdev$,"Print device" if dialog if pswit%=1 uopt$="D" else uopt$="P" endif rem if left$(ifmask$,1)<>"\" and mid$(ifmask$,2,1)<>":" and mid$(ifmask$,4,2)<>"::" rem ifmask$="\"+ifmask$ rem endif ifmask$=parse$(ifmask$,"\*.*",off%()) fmask$=ifmask$ sb%=0 :sback%=0 else uopt$="Q" endif endp proc allInit: pswit%=1 pdev$="PAR:A" endp proc loopInit: fndSwit%=0 endp proc dirPrint: local lc% lc%=0 :pg%=1 trap lopen pdev$ if err mess$="Invalid print device ("+pdev$+")" alert(mess$) return endif busy "Printing results..." lprint chr$(15) lprint "Files like",fmask$," Printed:",datim$," Page: 1" lprint frstFile: while fname$<>"" rem Print Line if lc%>56 lprint chr$(12) pg%=pg%+1 lprint "Files like",fmask$," Printed:",datim$," Page: ",pg% lprint lc%=0 endif lprint left$(fname$+" "+rept$(".",55),56); lprint props$: lc%=lc%+1 nextFile: endwh lprint lprint "END OF REPORT"; lprint " (Total size = ";totSize&;" bytes)" lprint chr$(12);chr$(18); lclose busy off giprint "Finished" endp proc exitDlog: if totSize&>0 giprint "Finished. "+gen$(totSize&,6)+" bytes." else giprint "No matching files were found" endif gcls endp proc frstFile: rem Find the first Matching File rem ignore Directories local i% s%=1 fmask$=ifmask$ s$(s%)=fmask$ i%=len(fmask$) while mid$(fmask$,i%,1)<>"\" :i%=i%-1 :endwh flname$=mid$(fmask$,i%+1,99) totSize&=0 fRestrt%=0 nextFile: endp proc nextFile: local i%,eswit%,ec% if s%=0 and fRestrt%=0 fname$="" return endif nfLoop:: if fRestrt%=1 a$=dir$("") goto testFile endif if s%>0 rem find all subdirectories fmask$=s$(s%) s%=s%-1 rem find \ at end of path name i%=len(fmask$) while mid$(fmask$,i%,1)<>"\" :i%=i%-1 :endwh fpath$=left$(fmask$,i%) eswit%=1 :onerr errlab:: a$=dir$(fpath$+"*.") onerr off while a$<>"" s%=s%+1 if s%>100 beep 5,300 alert("Program Stack Overflow") return endif s$(s%)=a$+"\" a$=dir$("") endwh filelab:: rem now get all file names that match eswit%=2 :onerr errlab:: a$=dir$(fpath$+flname$) onerr off testFile:: if a$<>"" fname$=a$ finfo: if (attrib% and $10) fRestrt%=1 goto nfLoop endif fndSwit%=1 props$: totSize&=totSize&+size& fRestrt%=1 return else fRestrt%=0 goto nfLoop endif else fname$="" endif return errlab:: ec%=err onerr off if abs(ec%)=38 alert("Bad file name") fname$="" return elseif abs(ec%)=42 if eswit%=1 :goto filelab:: elseif eswit%=2 fname$="" return endif endif beep 5,300 cls :print "Error: ",ec%,err$(ec%) get fname$="" return endp proc finfo: rem Obtain file size and status info fzts$=fname$+chr$(0) e%=call($887,addr(fzts$)+1,addr(ver%),0,0,0) ENDP proc props$: rem generate string containing file properties local rep$(128),ampm$(2) if e% rep$="Error obtaining properties" else rep$=" " fSize$=gen$(size&,-5) rep$=rep$+fSize$+" " secstodate mdate&,yr%,mo%,dy%,hr%,mn%,sc%,yrday% if hr%>12 ampm$="pm" hr%=hr%-12 else ampm$="am" endif fTime$=gen$(hr%,-2)+":"+mid$(gen$(100+mn%,-3),2,2)+ampm$ rep$=rep$+fTime$+" " fDate$=gen$(dy%,-2)+"/"+mid$(gen$(100+mo%,-3),2,2)+"/"+gen$(yr%,4) rep$=rep$+fDate$+" " if attrib% and $20 rep$=rep$+"Mod " fMod$="Y" else rep$=rep$+" " fMod$="N" endif if attrib% and $4 rep$=rep$+"Sys " fSys$="Y" else rep$=rep$+" " fSys$="N" endif if attrib% and $2 rep$=rep$+"Hid " fHid$="Y" else rep$=rep$+" " fHid$="N" endif if (Attrib% and $1)=0 rep$=rep$+"R/O" fRO$="Y" else fRO$="N" endif endif return rep$ endp proc dinit: local i%(32) gfont 9 :gstyle 1 colW%(1)=1 colW%(2)=12 colW%(3)=6 colW%(4)=3 colW%(5)=3 colW%(6)=3 colW%(7)=3 colW%(8)=10 colW%(9)=7 ncols%=9 ginfo i%() fontH%=i%(3) fontW%=i%(7) maxH%=160-(3*(3+fontH%)+2) lines%=int(maxH%/(1+fontH%)) maxH%=3*(3+fontH%)+2+lines%*(fontH%+1) uframe: endp proc nextDir: if fndSwit%=0 rem first time in so start at the top frstFile: upFlag%=0 busy "Scrolling forwards...",3,4 else if sback% rem Scrolling backwards busy "Scrolling backwards...",3,4 sb%=sb%-lines% frstFile: i%=1 while i%<=sb% and fname$<>"" nextFile: i%=i%+1 endwh sback%=0 if sb%<1 sb%=0 upFlag%=0 endif else busy "Scrolling forwards",3,4 rem next file already read on last pass upFlag%=1 endif endif uline%=1 gupdate off while fname$<>"" and uline%<=lines% storeF: dispF:(uline%) nextFile: uline%=uline%+1 endwh if uline%"-" sAct$(uline%)="A" disAct:(uline%) elseif (a%=%O or a%=%o) and sAct$(uline%)<>"-" sAct$(uline%)="O" disAct:(uline%) elseif (a%=%C or a%=%c) and sAct$(uline%)<>"-" sAct$(uline%)="C" disAct:(uline%) elseif (a%=%M or a%=%m) and sAct$(uline%)<>"-" sAct$(uline%)="M" disAct:(uline%) elseif (a%=%D or a%=%d) and sAct$(uline%)<>"-" sAct$(uline%)="D" disAct:(uline%) elseif a%=260 and upFlag%=1 rem set up a Page Up if chkActs: sback%=1 return endif elseif a%=261 and dnFlag%=1 rem set up a Page Down if chkActs: sb%=sb%+lines% return endif elseif a%=256 rem line up uline%=uline%-1 if uline%<1 uline%=lines% while sName$(uline%)="" uline%=uline%-1 endwh endif disCurs: elseif a%=257 rem line down uline%=uline%+1 if uline%>lines% uline%=1 elseif sName$(uline%)="" uline%=1 endif disCurs: elseif a%=13 doActs: uline%=1 while uline%<=lines% dispF:(uline%) uline%=uline%+1 endwh uline%=1 disCurs: elseif a%=27 rem Escape uopt$="Q" return elseif a%=32 and sAct$(uline%)<>"*" sAct$(uline%)=" " disAct:(uline%) elseif a%=291 helpMess: else beep 5,300 endif endwh endp proc storeF: rem Split the Name from the path local i% if fname$<>"" i%=len(fname$) while mid$(fname$,i%,1)<>"\" i%=i%-1 endwh sName$(uline%)=mid$(fname$,i%+1,80) sPath$(uline%)=left$(fname$,i%) sDate$(uline%)=fDate$ sTime$(uline%)=fTime$ sSize$(uline%)=fSize$ sMod$(uline%)=fMod$ sHid$(uline%)=fHid$ sSys$(uline%)=fSys$ sRO$(uline%)=fRO$ else sName$(uline%)="" endif sAct$(uline%)=" " endp proc dispF:(st%) local q% q%=2*(3+fontH%)+st%*(1+fontH%) gat colT%(1),q% gprintb sAct$(st%),colT%(2)-colT%(1)-2 gat colT%(2),q% gprintb sName$(st%),colT%(3)-colT%(2)-2 if sName$(st%)<>"" gat colT%(3),q% gprintb sSize$(st%),colT%(4)-colT%(3)-2 gat colT%(4),q% gprintb " "+sSys$(st%),colT%(5)-colT%(4)-2 gat colT%(5),q% gprintb " "+sRO$(st%),colT%(6)-colT%(5)-2 gat colT%(6),q% gprintb " "+sHid$(st%),colT%(7)-colT%(6)-2 gat colT%(7),q% gprintb " "+sMod$(st%),colT%(8)-colT%(7)-2 gat colT%(8),q% gprintb sDate$(st%),colT%(9)-colT%(8)-2 gat colT%(9),q% gprintb sTime$(st%),maxW%-colT%(9)-2 gat colT%(1),maxH%-2 gprintb "Path: "+sPath$(st%),colT%(8)-colT%(1) else gat colT%(3),q% gprintb "",colT%(4)-colT%(3)-2 gat colT%(4),q% gprintb " ",colT%(5)-colT%(4)-2 gat colT%(5),q% gprintb " ",colT%(6)-colT%(5)-2 gat colT%(6),q% gprintb " ",colT%(7)-colT%(6)-2 gat colT%(7),q% gprintb " ",colT%(8)-colT%(7)-2 gat colT%(8),q% gprintb "",colT%(9)-colT%(8)-2 gat colT%(9),q% gprintb "",maxW%-colT%(9)-2 gat colT%(1),maxH%-2 gprintb "Path:",colT%(8)-colT%(1) endif endp proc disCurs: gat colT%(1),maxH%-2 if sName$(uline%)<>"" gprintb "Path: "+sPath$(uline%),colT%(8)-colT%(1) else gprintb "Path:",colT%(8)-colT%(1) endif gat colT%(1),2*(3+fontH%)+uline%*(1+fontH%) cursor 1 endp proc disAct:(st%) gat colT%(1),2*(3+fontH%)+st%*(1+fontH%) gprintb sAct$(st%),colT%(2)-colT%(1)-2 gat colT%(1),2*(3+fontH%)+st%*(1+fontH%) cursor 1 endp proc chkActs: local i% rem scroll queried if any actions are set i%=1 while i%<=lines% if loc("CMD",sAct$(i%))>0 and sAct$(i%)<>"" i%=alert("Cannot scroll with Actions","","Don't Scroll","Lose Actions") if i%=1 return 0 else return 1 endif endif i%=i%+1 endwh return 1 endp proc disFlags: local flag$(9) flag$="" if dnFlag%=1 flag$="v " endif if upFlag%=1 flag$=flag$+chr$(350) endif if flag$<>"" flag$="Page: "+flag$ endif gat colT%(8),maxH%-2 gprintb flag$,maxW%-colT%(8)-2 endp proc uframe: local frq%,i%,here% frq%=maxH%-2*(fontH%+3) gat 0,0 glineby 0,maxH%+1 here%=0 i%=1 while i%<=(ncols%-1) colT%(i%)=here%+2 here%=here%+colW%(i%)*fontW%+3 gat here%,(fontH%+3) glineby 0,frq% i%=i%+1 endwh colT%(ncols%)=here%+2 here%=here%+colW%(ncols%)*fontW%+3 gat here%,0 glineby 0,maxH%+1 maxW%=here% gat 0,0 glineby maxW%+1,0 gat 0,(fontH%+3) glineby maxW%+1,0 gat 0,2*(fontH%+3) glineby maxW%+1,0 gat 0,(maxH%-(fontH%+3)) glineby maxW%+1,0 gat 0,maxH% glineby maxW%+1,0 gat colT%(3),fontH%+2 gprint "FILE MANAGER V3.0" frq%=2*(fontH%+2)+1 gat colT%(1),frq% gprint "A" gat colT%(2),frq% gprint "Name" gat colT%(3),frq% gprint "Size" gat colT%(4),frq% gprint "SYS" gat colT%(5),frq% gprint "R/O" gat colT%(6),frq% gprint "HID" gat colT%(7),frq% gprint "MOD" gat colT%(8),frq% gprint "Date" gat colT%(9),frq% gprint "Time" frq%=maxH%-2 gat colT%(1),frq% gprint "Path: " gat colT%(8),frq% gprint "Page:" endp proc runApp:(i%) local als$(5),pgname$(40),apname$(8),extn$(4) local pid%,cmdl$(128),ret% local ext$(3) ext$=mid$(sName$(i%),loc(sName$(i%),".")+1,3) if ext$="ODB" or ext$="DBF" pgname$="data" apname$="Data" extn$=".DBF" als$="" elseif ext$="WRD" or ext$="TXT" pgname$="word" apname$="Word" extn$=".WRD" als$="" elseif ext$="OPL" pgname$="word" apname$="Program" extn$=".OPL" als$="OROPL" elseif ext$="AGN" pgname$="agenda" apname$="Agenda" extn$=".AGN" als$="" elseif ext$="OPO" pgname$="SYS$PRGO" apname$="RunOpl" extn$=".OPO" als$="" elseif ext$="SPR" pgname$="SH3" apname$="Sheet" extn$=".SPR" als$="" elseif ext$="WVE" pgname$="record" apname$="Record" extn$=".WVE" als$="" else alert("Unrecognised extension ("+ext$+")") return endif if ext$="OPO" pgname$="ROM::"+pgname$+chr$(0) cmdl$="O"+apname$+chr$(0)+chr$(0)+sPath$(i%)+sName$(i%)+chr$(0) else pgname$="ROM::"+pgname$+".APP"+chr$(0) cmdl$="O"+apname$+chr$(0)+extn$+" "+als$+chr$(0)+sPath$(i%)+sName$(i%)+chr$(0) endif ret%=call($0187,addr(pgname$)+1,addr(cmdl$),0,0,addr(pid%)) if ret%<0 pgname$=left$(pgname$,len(pgname$)-1) alert("Couldn't start "+pgname$+" "+err$(ret%)) return endif sAct$(i%)="*" disAct:(i%) call($0688,pid%) endp proc helpMess: local id%,i%(32),x%,z% id%=gCreate(0,0,480,160,1) ginfo i%() z%=(i%(3)+i%(4)+i%(5)+2)/2 x%=z% gat 0,x% :x%=x%+z% gprint "Column A=Action Code as follows:-" :x%=x%+z% :gat 0,x% gprint "C=Copy file M=Move file" :x%=x%+z% :gat 0,x% gprint "O=Open File D=Delete file" :x%=x%+z% :gat 0,x% gprint "*=Action completed" :x%=x%+z% :gat 0,x% gprint "PgUp and PgDn if Page indicator is "+chr$(350)+" or v" :x%=x%+z% :gat 0,x% gprint "Up and Down move through the list" :x%=x%+z% :gat 0,x% gprint "Enter=carry out actions" :x%=x%+z% :gat 0,x% gprint "Esc=quit" :x%=x%+z% :gat 0,x% gprint "Press ENTER" get gclose id% endp proc doActs: i%=1 while i%<=lines% if sAct$(i%)="M" mActs:(i%) elseif sAct$(i%)="C" cActs:(i%) elseif sAct$(i%)="D" dActs:(i%) elseif sAct$(i%)="O" runApp:(i%) elseif sAct$(i%)="A" aActs:(i%) endif i%=i%+1 endwh endp proc cActs:(strt%) local st%,c1%,c2%,dn%,cc%,cpath$(80) st%=strt% dn%=1 cpath$="" rCopy:: dinit "Copy Files" dchoice dn%,"Destination","Common,Individual" c1%=dialog if c1% if dn%=1 cc%=1 dinit "Copy ALL marked(C) files to:-" dedit cpath$,"Destination" dchoice cc%,"Confirm","Yes,No" c2%=dialog if c2%>0 and cc%=1 onerr badCopy if right$(cpath$,1)<>"\" cpath$=cpath$+"\" endif while st%<=lines% if sAct$(st%)="C" copy sPath$(st%)+sName$(st%),cpath$ sAct$(st%)="*" disAct:(st%) endif st%=st%+1 endwh onerr off endif else do cc%=1 dinit "Confirm Copy" dtext "File:",sPath$(st%)+sName$(st%) dedit cpath$,"Destination" dchoice cc%,"Confirm","Yes,Skip,Quit" c2%=dialog if c2%>0 and cc%=1 onerr badCopy if right$(cpath$,1)<>"\" cpath$=cpath$+"\" endif copy sPath$(st%)+sName$(st%),cpath$ onerr off sAct$(st%)="*" disAct:(st%) endif if c2%>0 and cc%<>3 do st%=st%+1 if st%<=lines% if sAct$(st%)="C" break endif endif until st%>lines% endif if c2%=0 or cc%=3 or st%>lines% break endif until 0 endif endif goto cOut badCopy:: alert("Copy failed - likely bad path") onerr off goto rCopy cOut:: endp proc aActs:(strt%) local st%,dn% local hd%,sy%,ro%,mo% st%=strt% dn%=1 dinit "File Attributes" dchoice dn%,"Attributes","Common,Individual" if dialog if dn%=1 hd%=1 sy%=1 ro%=1 mo%=1 dinit "Attributes" dchoice sy%," System","As is,Yes,No" dchoice ro%,"Read/Only","As is,Yes,No" dchoice hd%," Hidden","As is,Yes,No" dchoice mo%," Modified","As is,Yes,No" if dialog while st%<=lines% if sAct$(st%)="A" modAttr:(st%,hd%,sy%,ro%,mo%) sAct$(st%)="*" disAct:(st%) endif st%=st%+1 endwh endif else do hd%=1 sy%=1 ro%=1 mo%=1 dinit "Attributes" dtext "File:",sPath$(st%)+sName$(st%) dchoice sy%," System","As is,Yes,No" dchoice ro%,"Read/Only","As is,Yes,No" dchoice hd%," Hidden","As is,Yes,No" dchoice mo%," Modified","As is,Yes,No" if dialog modAttr:(st%,hd%,sy%,ro%,mo%) sAct$(st%)="*" disAct:(st%) do st%=st%+1 if st%<=lines% if sAct$(st%)="A" break endif endif until st%>lines% else break endif if st%>lines% break endif until 0 endif endif endp proc modAttr:(st%,hd%,sy%,ro%,mo%) local fzts$(128),e%,mk% if hd%>1 if hd%=2 sHid$(st%)="Y" else sHid$(st%)="N" endif endif if sy%>1 if sy%=2 sSys$(st%)="Y" else sSys$(st%)="N" endif endif if ro%>1 if ro%=2 sRO$(st%)="Y" else sRO$(st%)="N" endif endif if mo%>1 if mo%=2 sMod$(st%)="Y" else sMod$(st%)="N" endif endif mk%=0 if sRO$(st%)="N" rem r/o works the opposite to the others mk%=mk%+1 endif if sHid$(st%)="Y" mk%=mk%+2 endif if sSys$(st%)="Y" mk%=mk%+4 endif if sMod$(st%)="Y" mk%=mk%+$20 endif fzts$=sPath$(st%)+sName$(st%)+chr$(0) e%=call($987,addr(fzts$)+1,$27,0,0,0) e%=call($987,addr(fzts$)+1,mk%,0,0,$ff) if e%<0 alert("Attrib failed ("+err$(e%)+")") endif dispF:(st%) endp proc dActs:(strt%) local st%,c1%,c2%,dn%,cc% st%=strt% dn%=1 rDel:: dinit "Delete ALL marked (D) Files" dchoice dn%,"Option","Yes-all,OneByOne" c1%=dialog if c1% if dn%=1 cc%=1 dinit "Delete ALL marked(D) Files" dchoice cc%,"Confirm","Yes,No" c2%=dialog if c2%>0 and cc%=1 onerr badDel while st%<=lines% if sAct$(st%)="D" delete sPath$(st%)+sName$(st%) sAct$(st%)="-" disAct:(st%) endif st%=st%+1 endwh onerr off endif else do cc%=1 dinit "Confirm Delete" dtext "File:",sPath$(st%)+sName$(st%) dchoice cc%,"Confirm","Yes,Skip,Quit" c2%=dialog if c2%>0 and cc%=1 onerr badDel delete sPath$(st%)+sName$(st%) onerr off sAct$(st%)="-" disAct:(st%) endif if c2%>0 and cc%<>3 do st%=st%+1 if st%<=lines% if sAct$(st%)="D" break endif endif until st%>lines% endif if c2%=0 or cc%=3 or st%>lines% break endif until 0 endif endif goto dOut badDel:: alert("Delete failed - probably R/O") onerr off sAct$(st%)="!" disAct:(st%) do st%=st%+1 if st%<=lines% if sAct$(st%)="D" break endif endif until st%0 and cc%=1 if right$(cpath$,1)<>"\" cpath$=cpath$+"\" endif while st%<=lines% if sAct$(st%)="M" onerr badMove1 copy sPath$(st%)+sName$(st%),cpath$ onerr badMove2 delete sPath$(st%)+sName$(st%) onerr off sAct$(st%)="-" disAct:(st%) endif st%=st%+1 endwh endif else do cc%=1 dinit "Confirm Copy" dtext "File:",sPath$(st%)+sName$(st%) dedit cpath$,"Destination" dchoice cc%,"Confirm","Yes,Skip,Quit" c2%=dialog if c2%>0 and cc%=1 onerr badMove1 if right$(cpath$,1)<>"\" cpath$=cpath$+"\" endif copy sPath$(st%)+sName$(st%),cpath$ onerr badMove2 delete sPath$(st%)+sName$(st%) onerr off sAct$(st%)="-" disAct:(st%) endif if c2%>0 and cc%<>3 do st%=st%+1 if st%<=lines% if sAct$(st%)="M" break endif endif until st%>lines% endif if c2%=0 or cc%=3 or st%>lines% break endif until 0 endif endif goto mOut badMove1:: alert("Move failed - likely bad path") onerr off goto rMove badMove2:: alert("Copy worked but delete failed") sAct$(st%)="!" disAct:(st%) do st%=st%+1 if st%<=lines% if sAct$(st%)="M" break endif endif until st%